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RRRRRRRR PPPPPPPP GGGGGGGG SSSSSSSS Qaaaaaa RRRRRRRR TTTTTTTITT 

RR RR PP PP GG SS Q QQ RR RR TT 

RR RR PP PP GG SS QQ QQ RR RR TT 

RR RR PP PP GG SS QQ QQ RR RR TT 

RR RR PP PP GG $$ QQ QQ RR RR TT 

RRRRRRRR PPPPPPPP GG SSSSSS QQ QQ RRRRRRRR TT 

RRRRRRRR PPPPPPPP GG SSSSSS QQ QQ RRRRRRRR TT 

RR RR PP GG GGGGGG SS QQ QQ QQ RR RR TT 

RR RR PP GG G6GGGGG S$ QQ QQ QQ RR RR TT 

RR RR PP GG GG S$ QQ QQ R RR TT ee 
RR RR PP SS QQ QQ RR RR TT coos 
RR RR PP GGGGGG SSSSSSSS QQQQ QQ RR RR TT eee 
RR RR PP GGGGGG SSSSSSSS QQQQ QQ RR RR TT cove 
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Get square root 


901 MODULE RPGS$SQRT 


{TLE 1 oGhobeuere roo 


( &T 
om ! file: RPGSQRT.B32 EDIT:DG1002 


BEGIN 


COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 


F 4 
1e-3ep-1986 $$:0e:26 — ERPGRTLSSREIR 
* 
' 


ey 

: 4 

3 5 1 

3 6 1 

: 7 1 

if } 

3 19 By ! . ALL RIGHTS RESERVED. 

3 i Sig 1 Ie THIS pore is FURNISHED UNDER A LICENSE AND MAY BE USED AND coPtED 
3 1 01 1 !* ONLY IN ANCE WITH THE TERMS OF SUCH Tat AND WITH THE 
Be || 014 1 I INCLUSION oF Orne ABOVE copyaieut NOTICE. THIS SOFTWARE OR ANY OTHER 
; 15 0015 1 !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY 
; 16 3018 1 '® OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 
3 + SEA : :* TRANSFERRED. 

3 fe 

; 9 0019 1 !'* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
3 20 0020 1 !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
s 1 oo 1 ! * CORPORATION. 

; '® 

3 7 00 - 1 '* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
; 4 0024 1 !'® SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 

+ = 0025 1 !# 

oo 0026 1 !* 

Z e7 00 i 4 See AAAAAAAA AAA AAAA AEA EA AAA AREA A AAA AERAAEEE AHA E 
te | 0028 1! 

3 9 0099 & 

3 0 0030 1! 

3 1 0031 1 !+4+ 

3 4 tT) 1 i FACILITY: RPGII SUPPORT 

AS. 0033 1! 

3 ‘ 0034 1 i ABSTRACT 

3 :? 0035 1} 

5 6 0036 1: This routine supports the RPG SQRT opcode. 

atm 0037 1: 

it; a 0038 1: 

3 ik sith ! ENVIRONMENT: Vax-11 User Mode 

s 641 0041 1 ! AUTHOR: Debess Grabazs, CREATION DATE: 8-Feb-1983 

3 $6 494 1} 

: & 004 1 | MODIFIED BY: 

s 64 pose 1 

: 645 45 1! 1-001 = Original. DG 8-Feb-1983 

; rh pons ' i 1-002 - Error RPGS_ INVDATTYP changed to RPG$_INVARG. DG 11-Jul-1983 

; «6448 0048 1 

: 49 0049 1 '<BLF/PAGE> 
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RPGSSQRT Get square root 16-9ep-1984 02:19:11 AX-11 Bliss-32 V4.0-742 Page 2 
1-00 $03 Declarations 15-308=138e 98 dei d6 RPGRTL.SRCJRPGSORT.B32;1 (2). 
; 51 } XSBTTL "Declarations' : 
: g 1 i * PROLOGUE FILE: : 
i a a 
; § 055 1 REQUIRE ‘RTLIN:RPGPROLOG'; ! Switches, PSECTs macros, > 
: 34 ; Y : i “Linkages and LIBRAR ‘ 
: §9 12 1 is | ; 
3 60 01 1 i LINKAGES 3 
s; 6) 126 1 NONE 3 
; 6¢ it: ee 3 
; 6 1 § 1 3 
>; 64 1 1 t+ 
: 65 1 3 1 ! TABLE OF CONTENTS: : 
; & 1 1 !- ; 
; oF 130 1 3 
: 68 0131 1 FORWARD ROUTINE : 
; & 01 § 1 RPG$SQRT : NOVALUE ; 3 
oe 01 1 ; 
— h 0134 1 !4 ; 
: ie 0135 1: seomnet FILES : 
ES 01 § 4 ONE : 
: 74 01 1 i- : 
SE: 0138 1 5 
a 0139 1 !+4 3 
ee 0140 1 | MACROS | : 
; 0141 1! NONE ; 
5 79 Big 1! $ 
; 80 0143 1 g 
ee wy 0144 1 !+¢ 3 
3 8 0145 1 ! EQUATED SYMBOLS P 
4 8 0146 1! NONE : 
; B84 0147 1 !- 3 
3; 6€68S B38 1 3 
; 686 149 1 !+4 3 
; 87 0150 1 ! EXTERNAL REFERENCES : 
; 8688 0151 1 !- 3 
; 8126 1 : 
; 01535 1 EXTERNAL ROUTINE 3 
; 91 0154 1 coesevt see R7: JSB -$7. ' Convert CIT + ad floatin ng ; 
9 0155 1 COBSCVTLI-R8: JSB B-678 ! Convert song Se CIT (with scaling) 3 
BS. 9138 1 COBSCVTPD” ff Ra ae 89, ! Convert ed to D_floatin ; 
: 694 157 1 COBSCV Tae 8 6789 7 ' Convert floatin fo packe 3 
: 95 158 1 COBSCV Tt Pay 533 5 ' Convert word to CIT (with scaling) 3 
; © 159 1 CTBSst OP ' Stop execution via signalling 3 
3 44 31g? : MTHSDSORT R5: JSB_D; ! Square root of D_floating : 
: Sieg | EXTERNAL LITERAL ance s aasatg best Gi soaeaan honk a 
2s : Square root of negative number : 
3 19) She: : RPGS$_INVARG; ! Invalid data type : 
: 108 106 1 EXTERNAL | : 
3; «6104 167 1 LIBSAB_CVTTP_O, ' Table for convert trailing to packed 3 
3; 105 168 1 RPGS$BI7; ! Table for translate blank to zero : 
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ZSBTTL ‘RPGSSQRT - Get square root' 
GLOBAL ROUTINE RPGS$SORT( 


4 
ep-1984 02:19:11 AX-11 Bliss-32 V4.0-742 
4 1982 Te ee RPGRTL.SRCJRPGSORT .B32;1 


LAGS ! Translation flag 
NUMBER: REF BLOCK -BYTEJ, ! Argument for square root operation 
ay UR BLOCKL BYTE ! Result of square root operation 

: s 


+ 
+ 


FUNCTIONAL DESCRIPTION 


This routine supports the RPG SQRT opcode. It is 
called once by the compiled code for each occurrence 
of the SQRT opcode for scalars, or once for each 
element of an errer. 

It accepts an input number of word, Long. packed, or 
right overpunched numeric data type; and outputs a 
packed result. 


CALLING SEQUENCE: 


COOOCOCOOOMOO08 NI NINN NNO 
NOUS WN — OOWONOULS WOO 


WAIAIRIPONININPINIPONONUPY 2 SS SS Se 


SIDE EFFECTS: 


If NUMBER is poget ive, the result field is set to zero and the 
error MTH$_SQUR 


4 CALL RPGS$SQRT (flags.rl.v, number.rx.ds, result.wp.ds) 
oy FORMAL PARAMETERS: 
35 flags longword integer - bit 1 set if blanks in 
9 overpunched numeric field should be treated 
94 as equivalent to zeroes; otherwise the 
e2 translation is not done. 
39 number address of descriptor of argument for square 
98 root operation. 

3 99 The allowable data types are word, long, 

; 4 packed, and right overpunched numeric. 

4 4 result address of descriptor of result of the square 

4 0 root operation. 

: be The allowable data type is packed. 

4 bg IMPLICIT INPUTS: 

4 

: NONE 

: IMPLICIT OUTPUTS: 

2 NONE 

: COMPLETION CODES: 

2 SS$_NORMAL 

5 

5 

5 

5 


ONEG is signalled. 
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; Get the scale factor. 
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RPGSSQRT Get square root 1b-se “19 2:19:11 AX-11 Bliss-32 V4.0-742 
e603 RPGSSORT = Get square root 1 ~$007 1382 96:02:36 RPGRTL. RCIRPGSORT .B32:1 
, 3 
8 BEGIN 
0 LITERAL 
1 BTZ_BIT = 2, ' Convert blanks to zeroes 
§ MAX_PACKED_LEN = 15; ! Maximum allowed packed decimal number length 
4 
5 D_VALUE: VECTOR(2), ! Input number converted to D_floating 
D-SQRT: VECTOR(2), ! D_ floating square root result 
; ALUE : VECTORCi2, BYTE), ! COBOL intermediate temporary 
‘ PACKED_LENGTH, 
PACKED-NUMBER: VECTOR CMAX_PACKED_LEN/2 + 1, BYTEJ, 
2 ! Packed decimal number 
SCALE; ! Scale factor 
BUILTIN 
CVTTP; ! Convert trailing to packed 


Pa SS SS 


le 
SCALE = (IF .NUMBERCDSC$B_CLASS]) gat DSCSK_CLASS_SD 
a gNUMBERCDSCSE_SCALE 


'¢ 
' 
Convert the input number to D_floating 


le 
SELECTONE .NUMBERCDSCS$B_DTYPE] OF 
DSCSK_DTYPE_w): ! Word 
BEGIN 


WN 9 OONOULS WN ( O OONOUS WN —OCO 


DENSI a sk kk kk tk td ot 0 ot ot ot 
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BERP UNAS SS LOOP ON LSSE NSRP ORAS ISIS M ON IS SSCS 


Par 


1+ 
' Convert word to CIT to d_floating 
(so scale doesn't get lost). 


COBSCVTWI_RB8 (.SCALE, .NUMBERCDSCSA_POINTER], I_VALUE); 
COBSCVTID“R7 (i_VALUE, D_VALUE); 


So 
oo 


END; 
COSC$K_bTYPE_L]: ! Long 
BEGIN 


'¢ 
' Convert long to CIT to d_floating 
(so scale doesn’t get lost). 


COBSCVTLI_R8 (.SCALE, .NUMBERCDSCSA_POINTER], I_VALUE); 
COBSCVTID“R? (i_VALUE, D_VALUE); 


33 END; 
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RPGSSQRT Get square root 16-Sep-1984 02:19:11 AX-11 Bliss-32 V4.0-742 P 
e805 RPGSSGRI - Get square root 12-80 8-138e 98:2 id RPGRTL.SRCJRPGSORT .B32;1 te (aS 
: : : COSCSK_DTYPE_PJ: ! Packed 
3 5 § COBSCVTPD_RO (.SCALE, .NUMBERCDSCSW_LENGTH], .NUMBERCDSCSA_POINTER], D_VALUE); 
; 89 CBSCEE A TVPE ROI: ! Right overpunched numeric 
; 91 IF (.FLAGS AND BTZ_BIT) NEQ 0 
: 1 35 THEN 
; ‘ p 3¢ | Translate blanks to zeroes if flag set. 
; 5 39 CHSTRANSLATE (RPGSBTZ, .NUMBERCDSC$W_LENGTH], .NUMBERCDSCSA_POINTER], 
; 7 44 z 0, .NUMBERCDSCS$W_LENGTAJ, .NUMBERLDSCSA_POINTER]); 
; $s 8 +4 ; Convert trailing to packed to d_floating. 
: 240 0301 PACKED_LENGTH = MAX_PACKED_LEN; 
: 241 44 CVTTP TNUMBERCDSC$W LENGTH], .NUMBERCDSCSA_POINTER], LIBSAB_CVTTP_O, PACKED_LENGTH, PACKED_NUMBE 
; “5 338? COBSCVTPD_R9 (.SCALE, MAX_PACKED_LEN, PACKED_NUMBER, D_VALUE); 
> 264 0305 END; 
> 245 0306 COTHERWISE): 
; 246 0307 
; 247 0308 LIBSSTOP (RPG$_INVARG); 
; ses 0309 
3; 249 0310 TES; 
: 250 0311 
3 ¢) b3i¢ ‘+ 
; 26 031 ‘ 
3; € 0314 ! Take the square root of the D_floating value and 
: 2¢ O38 convert the result to the output data type (packed) 
; 256 0317 in 
; 57 0318 MTHSDSQRT_RS (.D va ete). -D_VALUEC1]; D_SQRTCOJ, D_SQRTC1)); 
; 258 0319 SCALE = (IF .RESOLTCDSC$B_ CLASS) aL DSC$R_CLASS_SD 
: 366 Bgs¢ iy 34 gRESULTCOSCSB_SCALE 
; $01 8356 COBSCVTRDP-RO (=. SCALE, D_SQRT, .RESULTCDSCSW_LENGTH], .RESULTCDSCSA_POINTER]); 
: $8 0354 3 END; 


TITLE ROSSSORT Get square root 
-IDENT \1-002\ 

-EXTRN COBSCVTID_R7, COBSCVTLI_R8 
-EXTRN COBSCVTPD_R9, COBSCVTRDP_R9 
e-EXTRN COBSCVTWI_R8, LIBSSTOP 
-EXTRN MTHSDSQRT_RS, MTH$_SQUROONEG 
-EXTRN RPG$_INVARG, LIBSAB_CVTTP_O 
-EXTRN RPGSBTZ 


~PSECT _RPGSCODE,NOWRT, SHR, PIC.2 
OFFC 00000 -ENTRY Rogssent. Save R2,R3,R4,R5,R6,R7,RB.RIRIO,~; 0170 


000000006 00 


50 000000006 00 


RT = Get square root 
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50 02 
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5 08 
sie 
000000006 
08 
58 08 
57 04 
56 
000000006 
57 1¢ 
56 08 
000000006 
15 
59 1¢ 
58 04 
57 
13 
6C 
BA 
BA 
50 
BA 
59 1¢ 
38 
57 
56 
000000006 
0 000000006 
: eae? 
000000006 
r 
09 03 
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2:19:11 AX-11 Bliss-32 V4.0-742 
96 Oe: j 


RPGRTL.SRCJRPGSQRT.B32;1 


a9 
ahi SCALE 


NUMBER, R10 
wnt): 


(RIO), RO 
RO, #7 


(R16), a4(RT0), LIBSAB_CVTTP_O, - 
PACKED LENGTH, PACKED_NUMBER 


ALUE, R 
PACKED_NUMBER, R8 


#15, 
SCALE, R6 
COBSCVTPD_R9 


#RPGS_INVARG 
#1, LIBSSTOP 


D_VALUE, R 
MTHSDSORT_RS 


Pee Se Se Se Se Ge Ge Se Se Ge Ge Ge Se Se Ge Ge Fe Ge Se Fe Fe Ge Se Fe Fe Fe Se Se Se Se Seo Ge Fe Se Se Fo Fe Se Fe Se Se Se Be Se Fe Fe Ge Be Se Fe Be Be Fe Be Be Se 


1f 4 


RPGSSQRT Get square root -Se 4 1 AX-11 Bliss-32 V4.0-742 & 
805 RPGSSGRT = Get square root 12-888: 138 6: 4 MS RPGRTL.SRCIRPGSORT.B32:1 sae 
C D MNEGL SCALE, R 3 
i a Re a : 
000000006 ; 16 OO0DF JSB CoBSévTRDP_R9 : 
04 ES RET : 
; Routine Size: 230 bytes, Routine Base: _RPGSCODE + 0000 
: 264 O35? 1 
; 265 0326 0 END ELUDOM 
; PSECT SUMMARY 
; Name Bytes Attributes 
: _RPGSCODE 230 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 
: Library Statistics 
Bee Sa a er WS ae Syabe(s eooeces- Pages Processing 
: File Total Loaded Percent Mapped Time 
> _$255$DUA28:C(SYSLIBISTARLET.L32;1 9776 10 0 581 00:00.9 
> 7$255$DUA28: CRPGRTL.OBJIRPGLIB.L32;1 54 4 7 3 00:00.1 
: COMMAND QUALIFIERS 
; BLISS/CHECK=(FIELD, INITIAL, OPTIMIZE) /NOTRACE/LIS=LIS$:RPGSQRT/OBJ=OBJ$:RPGSQRT MSRC$:RPGSQRT/UPDATE=(ENH$:RPGSQRT) 


Sizes 230 soge : 0 data bytes 


ey Hass 0 518-5 
Lines/CPU Min: 217 
qorenee/SPe-Wigs 13430 
ry Used: 91 pages 
— ation Complete 
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